{-# LANGUAGE ForeignFunctionInterface  #-}
module HLibcell.Libcell(
    test,
    Storable,
    Node,

    
    VertexT,
    CellT,
    HalfT,
    FaceT,
    MeshT,
    libcell_read_cell,
  --   libcell_get_mesh_vertices,
    libcell_mesh_free,
    libcell_mesh_init) where
import HLibcell.HFunc
import Foreign
import Foreign.C
import Data.List 
-- import Data.Map.Lazy as M
import qualified Data.IntMap.Lazy as IMap


import Control.Monad.ST
import Control.Monad
-- import Data.STRef
import Data.IORef
import Data.Foldable
-- 不要用poke 


#include "libcell_wrapper.h"

double2cfloat :: Double -> CFloat
double2cfloat a= realToFrac a
double2cdouble ::Double->CDouble
double2cdouble a=realToFrac a 

float2cfloat :: Float -> CFloat
float2cfloat a= realToFrac a
cfloat2float :: CFloat ->Float
cfloat2float a= realToFrac a
cuint2int::CUInt->Int
cuint2int a= fromIntegral a
int2cuint :: Int -> CUInt
int2cuint a= fromIntegral a
cint2int::CInt->Int
cint2int a=fromIntegral a
int2cint::Int->CInt
int2cint a=fromIntegral a


data Node=Node{
    node_get_prev:: !(Ptr ()),
    node_get_value:: !(Ptr ()),
    node_get_next:: !(Ptr ()),
    node_get_traits:: !(Ptr ())
}



instance Storable Node where
    sizeOf _ = #{size Node}
    alignment _ = #{alignment Node}
    peek ptr =do
        prev <- peek (#{ptr Node,Prev} ptr)
        value <- peek (#{ptr Node, value} ptr)
        next <- peek (#{ptr Node,Next} ptr)
        traits <- peek (#{ptr Node, traits} ptr)
        pure (Node prev value next traits)
    poke ptr (Node prev value next traits)=do
        poke (#{ptr Node,Prev} ptr) prev 
        poke (#{ptr Node,value} ptr) value
        poke (#{ptr Node,Next} ptr) next
        poke (#{ptr Node,traits} ptr) traits



cstruct_Node_toList::Node->IO [Ptr ()]
cstruct_Node_toList n=do 
    m<-myfun $ node_get_next n
    return ((node_get_value n):m)
    where 
        myfun::Ptr ()-> IO [Ptr ()]
        myfun ptr =if ptr ==nullPtr 
            then return []
            else 
                cstruct_Node_toList =<< peek  (castPtr ptr::Ptr Node)



pcstruct_Node_toList::Ptr Node->IO ([(Ptr ())])
pcstruct_Node_toList ptr=if ptr ==nullPtr
    then return []
    else 
        cstruct_Node_toList =<< peek  (castPtr ptr::Ptr Node)


foreign import ccall "test"
    test:: IO ()
    
foreign import ccall "libcell_get_int_tree_begin"
    libcell_get_int_tree_begin:: Ptr ()->IO (Ptr ())

foreign import ccall "libcell_get_int_tree_next"
    libcell_get_int_tree_next:: Ptr ()->IO (Ptr ())

foreign import ccall "libcell_get_int_tree_node_key"
    libcell_get_int_tree_node_key :: Ptr ()->IO Int

foreign import ccall "libcell_get_int_tree_node_value"
    libcell_get_int_tree_node_value ::Ptr ()->IO (Ptr())

foreign import ccall "int_rb_tree_insert"
    libcell_int_tree_insert::Ptr (IMap.IntMap a)->Int->Ptr ()->IO ()


libcell_create_int_map_from_c::Ptr ()->IO (IMap.IntMap (Ptr ()))
libcell_create_int_map_from_c ptr=do
    mp<-newIORef IMap.empty
    start<-libcell_get_int_tree_begin ptr
    myfun1 start mp
    myfun ptr mp
    readIORef mp
    where
        myfun1:: Ptr ()-> IORef (IMap.IntMap (Ptr ()))->IO ()
        myfun1 ptr1 mp1=if ptr1==nullPtr 
            then
                return ()
            else do
                key<- libcell_get_int_tree_node_key ptr1
                value<- libcell_get_int_tree_node_value ptr1
                modifyIORef mp1 (\x->IMap.insert key value  x)
        myfun::Ptr ()-> IORef (IMap.IntMap (Ptr ()))->IO()
        myfun ptr1 mp1=do
            next<- libcell_get_int_tree_next ptr1
            if next/=nullPtr then do
                myfun1 next mp1
                myfun ptr1 mp1
            else
                return ()




instance (Storable a)=>Storable (IMap.IntMap a) where 
    sizeOf _ = #{size Int_RB_Tree}
    alignment _ = #{alignment Int_RB_Tree} 
    peek ptr =do 
        mp<-libcell_create_int_map_from_c $(castPtr  ptr::Ptr ()) 
        IMap.traverseWithKey  (\k v-> peek (castPtr v::Ptr a)) mp 
    poke ptr mp=do 
        IMap.foldrWithKey' (\k v b->do 
            b
            v1<-new v
            libcell_int_tree_insert ptr k (castPtr v1::Ptr ())  ) (return ()) mp






-- foreign import ccall "free_node"
--     libcell_free_node::Ptr Node->IO ()



        


-- viewer_create_cfloat_array_from_vector::V.Vector Float-> IO (Ptr CFloat)
-- viewer_create_cfloat_array_from_vector vv =if vv==V.empty
--     then return nullPtr
--     else do
--         let 
--             len=length vv
--             size=sizeOf (1::CFloat)
--             myfun::V.Vector Float->Ptr CFloat->Int->IO()
--             myfun vv1 ptr1 num =if num>=len 
--                 then return ()
--                 else do
--                     pokeByteOff ptr1 (num*size) $ float2cfloat $ vv1 V.! num 
--                     --viewer_set_float_array_at_i ptr1 num $ float2cfloat $ vv1 V.! num
--                     myfun vv1 ptr1 (num+1)             
--         ptr <- mallocBytes $len * size
--         myfun vv ptr 0 
--         return ptr






-- foreign import ccall "libcell_get_mesh_vertices"
--     libcell_get_mesh_vertices::Ptr (HMesh m v hf f c)->IO (Ptr (IMap.IntMap (HVertex v)))






-- foreign import ccall "int_rb_tree_free"
--     int_rb_tree_free::



foreign import ccall "libcell_get_pcell_id"
    libcell_get_pcell_id:: Ptr ()->IO Int

foreign import ccall "libcell_get_pvertex_id" 
    libcell_get_pvertex_id:: Ptr ()->IO Int
 
foreign import ccall "libcell_get_phalfface_id" 
    libcell_get_phalfface_id:: Ptr ()->IO Int

foreign import ccall "libcell_get_pface_id" 
    libcell_get_pface_id:: Ptr ()->IO Int
data VertexT=VertexT{
    vertext_get_id::Int
}deriving(Show)

data CellT =CellT{
    cellt_get_id::Int
}deriving(Show)

data HalfT=HalfT{
    halft_get_id::Int 
}deriving(Show )

data FaceT=FaceT{
    facet_get_id::Int
}deriving(Show)

data MeshT =MeshT{
    mesht_get_id::Int
}deriving(Show)

instance Storable VertexT where 
    sizeOf   _ = #{size VertexT}
    alignment _ = #{alignment VertexT}
    peek ptr = do 
        id1<- return.cint2int=<<peek (#{ptr VertexT,id} ptr)
        pure (VertexT id1)
    poke ptr (VertexT id1)=do 
        poke (#{ptr VertexT,id} ptr) $ int2cint id1


instance Storable CellT where 
    sizeOf _ = #{size CellT}
    alignment _ = #{alignment CellT}
    peek ptr = do 
        id1<- return.cint2int=<< peek (#{ptr CellT,id} ptr)
        pure (CellT id1 )
    poke ptr (CellT id1)=do 
        poke (#{ptr CellT,id} ptr) $ int2cint id1



instance Storable FaceT where
    sizeOf _ = #{size FaceT}
    alignment _ = #{alignment FaceT}
    peek ptr = do 
        id1 <- return.cint2int=<< peek (#{ptr FaceT,id} ptr)
        pure (FaceT id1)
    poke ptr (FaceT id1) =do 
        poke (#{ptr FaceT,id} ptr)$ int2cint id1




instance Storable HalfT where
    sizeOf _ = #{size HalfT}
    alignment _ = #{alignment HalfT}
    peek ptr = do 
        id1 <- return.cint2int=<< peek (#{ptr HalfT,id} ptr)
        pure (HalfT id1)
    poke ptr (HalfT id1) =do 
        poke (#{ptr HalfT,id} ptr)$ int2cint id1


instance Storable MeshT where 
    sizeOf _ = #{size MeshT}
    alignment _ = #{alignment MeshT}
    peek ptr = do 
        id1 <- return.cint2int=<<peek (#{ptr MeshT,id } ptr)
        pure (MeshT id1)
    poke ptr (MeshT id1)=do  
        poke (#{ptr MeshT,id} ptr) $int2cint id1 





instance (Storable v)=> Storable (HVertex v ) where
    sizeOf _ = # {size Vertex}
    alignment _ = #{alignment Vertex}
    peek ptr= do 
        id1 <- return.cint2int=<< peek (#{ptr Vertex,id } ptr)
        ptr1<- peek (#{ptr Vertex,point} ptr)
        point_size<- return.cint2int=<<peek (#{ptr Vertex,point_size} ptr)
        point1 <- peekArray point_size ptr1
        faces<- peek (#{ptr Vertex,faces} ptr)
        cells<- peek (#{ptr Vertex,cells} ptr)
        faces1<- mapM libcell_get_pface_id =<<pcstruct_Node_toList faces  
        cells1<- mapM libcell_get_pcell_id =<<pcstruct_Node_toList cells
        vt<- peek (#{ptr Vertex,traits} ptr)
        pure (HVertex id1 point1 cells1 faces1 (Just vt))   
    poke ptr (HVertex id1 point1 cells1 faces1 vt)=do
        poke  (#{ptr Vertex,id} ptr) $ int2cint id1 
        ptr1<- peek (#{ptr Vertex,point} ptr)
        pokeArray ptr1 point1 
        poke (#{ptr Vertex,point_size} ptr) $ int2cint $length point1
        myfun (#{ptr Vertex,traits} ptr) vt
        where 
            myfun ::(Storable v)=> Ptr v->Maybe v->IO ()
            myfun _ Nothing = return ()
            myfun pvt1 (Just y)= poke pvt1 y  


    --     poke ptr1 point1
        

instance (Storable hf)=>Storable (HHalfFace hf) where
    sizeOf _ = #{size HalfFace}
    alignment _ = #{alignment HalfFace}
    peek ptr = do 
        id1<- return.cint2int=<< peek (#{ptr HalfFace,id} ptr)
        ptr1<- peek (#{ptr HalfFace,vertices} ptr) 
        vertices_size<-return.cint2int=<< peek (#{ptr HalfFace,vertices_size} ptr)
        vers1<- peekArray vertices_size ptr1
        vers<- mapM libcell_get_pvertex_id vers1 
        ptr2<-peek (#{ptr HalfFace,cell} ptr)
        cell <- libcell_get_pcell_id ptr2 
        ptr3<- peek (#{ptr HalfFace,face} ptr)
        face <- libcell_get_pface_id ptr3 
        hft<- peek (#{ptr HalfFace,traits} ptr)
        pure (HHalfFace id1 vers cell face (Just hft) ) 
    poke ptr (HHalfFace id1 vers cell face hft)=do 
        poke (#{ptr HalfFace,id} ptr) $ int2cint id1
        poke (#{ptr HalfFace,vertices_size} ptr) $ int2cint $ length vers 
        myfun (#{ptr HalfFace,traits} ptr) hft
        where 
            myfun ::(Storable v)=> Ptr v->Maybe v->IO ()
            myfun _ Nothing = return ()
            myfun pvt1 (Just y)= poke pvt1 y   


instance (Storable f)=>Storable (HFace f) where 
    sizeOf _ = #{size Face} 
    alignment _ = #{alignment Face}
    peek ptr = do 
        id1<- return.cint2int =<< peek (#{ptr Face,id} ptr)  
        ptr1<- peek (#{ptr Face,vertices} ptr ) 
        vertices_size<- return.cint2int=<< peek (#{ptr Face,vertices_size} ptr)
        vers1 <- peekArray vertices_size ptr1
        vers<- mapM libcell_get_pvertex_id vers1 
        hfs<- mapM libcell_get_phalfface_id =<<peekArray 2 (#{ptr Face,halffaces} ptr)
        ft<- peek (#{ptr Face,traits} ptr)
        pure (HFace id1 vers (hfs !! 0) (hfs !! 1) (Just ft) ) 

    poke ptr (HFace id1 vers hfs1 hfs2 ft )= do 
        poke (#{ptr Face,id} ptr) id1 
        poke (#{ptr Face,vertices_size} ptr) $ int2cint $ length vers 
        myfun (#{ptr Face,traits} ptr) ft
        where 
            myfun ::(Storable v)=> Ptr v->Maybe v->IO ()
            myfun _ Nothing = return ()
            myfun pvt1 (Just y)= poke pvt1 y    





instance (Storable c)=>Storable (HCell c) where
    sizeOf _ = #{size Cell}
    alignment _ = #{alignment Cell}
    peek ptr = do 
        id1 <- return.cint2int=<< peek (#{ptr Cell,id } ptr)
        ptr1<- peek (#{ptr Cell,vertices} ptr)
        vertices_size<- return.cint2int=<< peek (#{ptr Cell,vertices_size} ptr)
        vers1<- peekArray vertices_size ptr1 
        vers <- mapM libcell_get_pvertex_id vers1 
        ptr2<- peek (#{ptr Cell, halffaces} ptr)
        hfs<- mapM libcell_get_phalfface_id=<<pcstruct_Node_toList ptr2
        ct<- peek (#{ptr Cell,traits} ptr)
        pure (HCell id1 vers hfs (Just ct ))
    poke ptr (HCell id1 vers hfs ct)=do 
        poke (#{ptr Cell,id} ptr) id1 
        poke (#{ptr Cell,vertices_size} ptr) $ int2cint $ length vers 
        myfun (#{ptr Cell,traits} ptr) ct
        where 
            myfun ::(Storable v)=> Ptr v->Maybe v->IO ()
            myfun _ Nothing = return ()
            myfun pvt1 (Just y)= poke pvt1 y    


 






        -- myfun::IMap.IntMap (HVertex v) ->Int ->Ptr (Ptr CDouble)->IO ()
        -- myfun vers1 num ptr1=if num>= len 
        --     then return ()
        --     else do 
        --         ptr2<- mallocBytes $ size2* len1 
        --         pokeByteOff ptr1  (num*size1) ptr2
        --         myfun vers1 (num+1) ptr1

        --myfun1:: 




libcell_create_cdouble_array_from_intmap::IMap.IntMap (HVertex v)->IO (Ptr (Ptr CDouble))
libcell_create_cdouble_array_from_intmap vers= do 
    ptr<-mallocBytes $ len * size1
    return.snd=<<foldlM  myfun (0,ptr) vers    
    where
        len=IMap.size vers 
        len1=length $ hvertex_get_point $ snd $ IMap.findMin vers   
        size1=sizeOf (nullPtr::Ptr CDouble)
        size2=sizeOf (1::CDouble) 
        myfun ::(Int,Ptr (Ptr CDouble))->HVertex v->IO (Int,Ptr (Ptr CDouble))
        myfun (num,ptr1) vertex =do 
            ptr2<-mallocBytes $ size2*len1 
            pokeArray ptr2 $ map double2cdouble $ hvertex_get_point vertex
            pokeByteOff ptr1 (num*size1) ptr2
            return (num+1,ptr1)


libcell_create_cint_array_from_intmap ::IMap.IntMap (HHalfFace hf)-> IO (Ptr (Ptr CInt))
libcell_create_cint_array_from_intmap halffaces = do 
    ptr<- mallocBytes $ len* size1 
    return.snd=<<foldM myfun (0,ptr) halffaces 
     
    where 
        len=IMap.size halffaces
        size1=sizeOf (nullPtr ::Ptr CInt)
        size2= sizeOf (1::CInt)
        myfun :: (Int,Ptr (Ptr CInt))->HHalfFace hf ->IO (Int ,Ptr (Ptr CInt))
        myfun (num,ptr1) halfface= do 
            len1<-return $length $ hhalfface_get_vertices halfface
            ptr2<- mallocBytes $ size2* (1 + len1) 
            pokeArray ptr2 $ len1: hhalfface_get_vertices halfface
            pokeByteOff ptr1 (num*size1) ptr2 
            return (num+1,ptr1)


libcell_create_cint_array_from_intmap1::IMap.IntMap (HCell c)->IO (Ptr (Ptr CInt))
libcell_create_cint_array_from_intmap1 cells = do 
    ptr<- mallocBytes $ len* size1 
    return.snd=<<foldM myfun (0,ptr) cells 
    where 
        len=IMap.size cells
        size1=sizeOf (nullPtr ::Ptr CInt)
        size2= sizeOf (1::CInt)
        myfun :: (Int,Ptr (Ptr CInt))->HCell hf ->IO (Int ,Ptr (Ptr CInt))
        myfun (num,ptr1) cell= do 
            len1<-return $length $ hcell_get_halffaces cell
            ptr2<- mallocBytes $ size2* (1 + len1) 
            pokeArray ptr2 $ len1: hcell_get_halffaces cell
            pokeByteOff ptr1 (num*size1) ptr2 
            return (num+1,ptr1)


libcell_create_cint_array_from_intmap2::IMap.IntMap (HCell c)->IO (Ptr (Ptr CInt))
libcell_create_cint_array_from_intmap2 cells = do 
    ptr<- mallocBytes $ len* size1 
    return.snd=<<foldM myfun (0,ptr) cells 
    where 
        len=IMap.size cells
        size1=sizeOf (nullPtr ::Ptr CInt)
        size2= sizeOf (1::CInt)
        myfun :: (Int,Ptr (Ptr CInt))->HCell hf ->IO (Int ,Ptr (Ptr CInt))
        myfun (num,ptr1) cell= do 
            len1<-return $length $ hcell_get_vertices cell
            ptr2<- mallocBytes $ size2* (1 + len1) 
            pokeArray ptr2 $ len1: hcell_get_vertices cell
            pokeByteOff ptr1 (num*size1) ptr2 
            return (num+1,ptr1)





foreign import ccall "Mesh_init"
    libcell_mesh_init::Ptr (HMesh m v hf f c)->IO ()


foreign import ccall "Mesh_free"
    libcell_mesh_free::Ptr (HMesh m v hf f c)->IO ()



foreign import ccall "LibCell_ReadArray_"
    libcell_read_array_:: Ptr (HMesh m v hf f c)->  Ptr (Ptr CDouble)->Ptr (Ptr CInt)->Ptr (Ptr CInt)->Ptr CInt->Int->Int->IO ()



instance  (Storable m,Storable v ,Storable hf,Storable f,Storable c)=>Storable (HMesh m v hf f c) where
    sizeOf _ = #{size Mesh}
    alignment _ = #{alignment Mesh}
    peek ptr =do 
        ptr1<- peek (#{ptr Mesh,cells} ptr)
        cells<-peek ptr1
        ptr2<- peek (#{ptr Mesh,faces} ptr)
        faces<- peek ptr2
        ptr3<- peek (#{ptr Mesh,vertices} ptr)
        vertices<- peek ptr3
        ptr4<- peek (#{ptr Mesh ,halffaces} ptr)
        halffaces<- peek ptr4 
        c_n_id<-return.cint2int=<<peek (#{ptr Mesh,cell_id } ptr)
        f_n_id<-return.cint2int=<<peek (#{ptr Mesh,face_id} ptr)
        v_n_id<- return.cint2int=<<peek (#{ptr Mesh,vertex_id} ptr)
        hf_n_id<- return.cint2int=<< peek (#{ptr Mesh,halfface_id} ptr)   
        dim<- return.cint2int=<<peek (#{ptr Mesh,dimension} ptr)
        simi<-return.cint2int =<< peek (#{ptr Mesh,simplex} ptr )
        mani<-return.cint2int=<<peek (#{ptr Mesh,manifold_require} ptr)
        traits<-peek (#{ptr Mesh ,traits} ptr)
        pure (HMesh vertices halffaces faces cells v_n_id hf_n_id f_n_id c_n_id dim 
            ((\x->if x==0 then False else True) simi) ((\x->if x==0 then False else True) mani) (Just traits))  
    poke ptr mesh =do
        libcell_mesh_free ptr 
        libcell_mesh_init ptr  
        vv<-libcell_create_cdouble_array_from_intmap $ hmesh_get_vertices mesh
        nums<- mallocBytes $ 3*(sizeOf (undefined ::CInt))

        poke nums $ int2cint $length $ hmesh_get_vertices mesh 
        if hmesh_get_simplex mesh then do 
            cc<- libcell_create_cint_array_from_intmap2 $ hmesh_get_cells mesh 
            poke (ptr `plusPtr` (sizeOf (undefined::CInt))) (0::CInt) 
            poke (ptr `plusPtr` (2*sizeOf (undefined::CInt))) $ int2cint $ length $ hmesh_get_cells mesh 
            libcell_read_array_ ptr vv nullPtr cc nums (hmesh_get_back_dim mesh) (hmesh_get_dimension mesh )

            myfun cc $ length $ hmesh_get_cells mesh 

            return ()
        else do 
            ff<-libcell_create_cint_array_from_intmap $ hmesh_get_halffaces mesh 
            cc<- libcell_create_cint_array_from_intmap1 $ hmesh_get_cells mesh 
            poke (ptr `plusPtr` (sizeOf (undefined::CInt))) $ int2cint $ length $ hmesh_get_halffaces mesh 
            poke (ptr `plusPtr` (2*sizeOf (undefined::CInt))) $ int2cint $ length $ hmesh_get_cells mesh 
            -- poke (ptr  `plusPtr` (sizeOf (undefined)) ) 
            libcell_read_array_ ptr vv ff cc nums (hmesh_get_back_dim mesh) (hmesh_get_dimension mesh )

            myfun ff $ length $ hmesh_get_halffaces mesh 
            myfun cc $ length $ hmesh_get_cells mesh 

            return ()
        free nums
        myfun vv $ length $ hmesh_get_vertices mesh  
        free vv
        return ()

        where 
            size1= sizeOf (undefined::Ptr CInt)
            myfun:: Ptr (Ptr a) ->Int ->IO ()
            myfun ptr1 len1=myfun2 (ptr1,0) len1 

            myfun1:: (Ptr (Ptr a),Int)->IO (Ptr (Ptr a),Int)
            myfun1 (ptr1,len1)=do 
                ptr2<-peekByteOff  ptr1 (size1* len1) :: IO (Ptr a)  
                free ptr2
                return (ptr1,len1+1)
            myfun2::(Ptr (Ptr a),Int)->Int ->IO ()
            myfun2 (ptr1 ,len1) len2= do
                if len1>= len2 then 
                    return ()
                else do 
                    (ptr2,len3)<- myfun1 (ptr1,len1)
                    myfun2 (ptr2,len3) len2
-- --            
-- --        


foreign import ccall "libcell_read_cell_"
    libcell_read_cell_::CString->IO (Ptr (HMesh m v hf f c))


libcell_read_cell ::String->IO (Ptr (HMesh m v hf f c))
libcell_read_cell str= do 
    s<-newCString str 
    pm<-libcell_read_cell_ s 
    free s 
    return pm










